home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / basic / qbfaqr01.zip / LABEL.BAS < prev    next >
BASIC Source File  |  1992-08-10  |  5KB  |  112 lines
  1. ' VOLUME.BAS    Gets and/or Sets the disk volume label using DOS
  2. '               Extended File Control Block (FCB) services. This
  3. '               works with all MS-DOS versions from 2.0 up.
  4. '
  5. 'Note that, while the ReadLabel routine will find the volume label from
  6. 'whichever subdirectory you happen to be in, the MakeLabel routine only
  7. 'works from the root directory of the drive you're relabelling.
  8. '
  9. '
  10. '   Author:     Christy Gemmell
  11. '   For:        David Bliss
  12. '   Date:       19/5/1992
  13. '
  14. '   $DYNAMIC
  15. '
  16. '   $INCLUDE: 'QB.BI'                       ' Use QBX.BI for PDS
  17. '
  18.     DECLARE SUB MakeLabel (Drive$, Label$)
  19.     DECLARE SUB ReadLabel (Drive$, Label$)
  20.  
  21.     CONST FALSE = 0, TRUE = NOT FALSE
  22.  
  23.     TYPE XFCBType
  24.         XFlag AS STRING * 1                 ' Extended FCB signature
  25.         Rsrv1 AS STRING * 5                 ' Reserved (do not use)
  26.         Attr  AS STRING * 1                 ' File attribute
  27.         Drive AS STRING * 1                 ' Drive number
  28.         FName AS STRING * 11                ' Filename
  29.         Rsrv2 AS STRING * 5                 ' Reserved (do not use)
  30.         NName AS STRING * 11                ' Replacement name
  31.         Rsrv3 AS STRING * 9                 ' Reserved (do not use)
  32.     END TYPE
  33.  
  34.     DIM SHARED FCB AS XFCBType              ' File Control Block
  35.     DIM SHARED InRegs AS RegTypeX           ' Register structures
  36.     DIM SHARED OutRegs AS RegTypeX          '   for interrupt calls
  37.  
  38.     DIM SHARED DTA AS STRING * 64           ' Disk Transfer Area
  39.  
  40.     LSET FCB.XFlag = CHR$(255)              ' Flag as Extended FCB
  41.     LSET FCB.Rsrv1 = STRING$(5, 0)          ' Fill with nulls
  42.  
  43. '   Example program to test it all out.
  44. '
  45.     CLS
  46.     Drive$ = "A:": Label$ = ""
  47.     ReadLabel Drive$, Label$
  48.     LOCATE 10, 1: PRINT "Current Label = "; Label$
  49.     Label$ = "DidItWork"
  50.     MakeLabel Drive$, Label$
  51.     LOCATE 12, 1: PRINT "New Label     = "; Label$
  52. END
  53.  
  54. '   Creates or changes the volume label of the drive specified
  55. '
  56. SUB MakeLabel (Drive$, Label$) STATIC
  57.     NewLabel$ = Label$                      ' Preserve new label
  58.     ReadLabel Drive$, Label$                ' Search for current label
  59.     IF Label$ = "" THEN                     ' If no label found
  60.        LSET FCB.FName = NewLabel$           '    Set new label
  61.        InRegs.ds = VARSEG(FCB)              '    Segment and offset of
  62.        InRegs.dx = VARPTR(FCB)              '      our File Control Block
  63.        InRegs.ax = &H1600                   '    Create file
  64.        INTERRUPTX &H21, InRegs, OutRegs     '    Call DOS
  65.        InRegs.ax = &H1000                   '    Close file
  66.        INTERRUPTX &H21, InRegs, OutRegs     '    Call DOS
  67.     ELSE                                    ' Otherwise
  68.        LSET FCB.FName = Label$              '    Set current label
  69.        LSET FCB.NName = NewLabel$           '    Set replacement label
  70.        InRegs.ds = VARSEG(FCB)              '    Segment and offset of
  71.        InRegs.dx = VARPTR(FCB)              '      our File Control Block
  72.        InRegs.ax = &H1700                   '    Rename file
  73.        INTERRUPTX &H21, InRegs, OutRegs     '    Call DOS
  74.     END IF
  75.     Label$ = ""                             ' Check to see
  76.     ReadLabel Drive$, Label$                '    if it worked
  77. END SUB
  78.  
  79. '   Reads the volume label of the drive specified.
  80. '
  81. SUB ReadLabel (Drive$, Label$) STATIC
  82.     InRegs.ax = &H2F00                      ' Get current DTA
  83.     INTERRUPTX &H21, InRegs, OutRegs        ' Call DOS
  84.     DTASeg% = OutRegs.es                    ' Store DTA segment
  85.     DTAOff% = OutRegs.bx                    ' Store DTA offset
  86.     InRegs.ds = VARSEG(DTA)                 ' Replace with
  87.     InRegs.dx = VARPTR(DTA)                 '    our own temporary
  88.     InRegs.ax = &H1A00                      '    Disk Transfer Area
  89.     INTERRUPTX &H21, InRegs, OutRegs        ' Call DOS
  90.     IF Drive$ = "" THEN                     ' If no drive
  91.        Disk% = 0                            '    letter is supplied
  92.     ELSE                                    '    use current drive
  93.        Disk% = ASC(UCASE$(Drive$)) - 64     '    otherwise convert
  94.     END IF                                  '    letter to numeral
  95.     LSET FCB.Drive = CHR$(Disk%)            ' Drive to search
  96.     LSET FCB.Attr = CHR$(8)                 ' Specify Volume label
  97.     LSET FCB.FName = "???????????"          ' Use wildcards for search
  98.     InRegs.ds = VARSEG(FCB)                 ' Segment and offset of
  99.     InRegs.dx = VARPTR(FCB)                 '    our File Control Block
  100.     InRegs.ax = &H1100                      ' Find first match
  101.     INTERRUPTX &H21, InRegs, OutRegs        ' Call DOS
  102.     IF OutRegs.ax MOD 256 = &HFF THEN       ' If a label wasn't found
  103.        Label$ = ""                          '    return a null string
  104.     ELSE                                    '    otherwise
  105.        Label$ = MID$(DTA, 9, 11)            '    extract it from
  106.     END IF                                  '    our DTA
  107.     InRegs.ds = DTASeg%                     ' Restore
  108.     InRegs.dx = DTAOff%                     '    original
  109.     InRegs.ax = &H1A00                      '    Disk Transfer Area
  110.     INTERRUPTX &H21, InRegs, OutRegs        ' Call DOS
  111. END SUB
  112.